/// Builtin functions for building the CLI
/// (as opposed to functions needed by CLI programs, which are in StdLibCli)
module BuiltinCliHost.Libs.Cli

open System.Threading.Tasks
open FSharp.Control.Tasks


open Prelude
open LibExecution.RuntimeTypes
open LibExecution.Builtin.Shortcuts

module PT = LibExecution.ProgramTypes
module RT = LibExecution.RuntimeTypes
module VT = LibExecution.ValueType
module Dval = LibExecution.Dval
module PT2RT = LibExecution.ProgramTypesToRuntimeTypes
module RT2DT = LibExecution.RuntimeTypesToDarkTypes
module PT2DT = LibExecution.ProgramTypesToDarkTypes
module Exe = LibExecution.Execution
module PackageIDs = LibExecution.PackageIDs
module Json = BuiltinExecution.Libs.Json
module C2DT = LibExecution.CommonToDarkTypes
module D = LibExecution.DvalDecoder

module Utils = BuiltinCliHost.Utils


module BranchID =
  let fromDT = C2DT.Option.fromDT D.uuid
  let toDT = C2DT.Option.toDT Dval.uuid KTUuid


// Get PackageManager instance with error handling
let executePM
  (exeState : RT.ExecutionState)
  (branchID : Option<System.Guid>)
  : Ply<Dval> =
  uply {
    let getPmFnName = FQFnName.Package PackageIDs.Fn.LanguageTools.PackageManager.pm

    let! execResult =
      Exe.executeFunction exeState getPmFnName [] (NEList.singleton DUnit)

    match execResult with
    | Ok dval -> return dval
    | Error(rte, _cs) ->
      let! rteString = Exe.runtimeErrorToString branchID exeState rte
      match rteString with
      | Ok rte ->
        return Exception.raiseInternal "Error executing pm function" [ "rte", rte ]
      | Error(nestedRte, _cs) ->
        return
          Exception.raiseInternal
            "Error running runtimeErrorToString"
            [ "original rte", rte; "nested rte", nestedRte ]
  }

// Create OnMissing.Allow enum value
let createOnMissingAllow () : Dval =
  let onMissingType =
    FQTypeName.Package
      PackageIDs.Type.LanguageTools.NameResolver.nameResolverOnMissing
  DEnum(onMissingType, onMissingType, [], "Allow", [])

// Create exception error from exn
let createExceptionError (e : exn) : RuntimeError.Error =
  RuntimeError.UncaughtException(
    Exception.getMessages e |> String.concat "\n",
    Exception.toMetadata e |> List.map (fun (k, v) -> (k, DString(string v)))
  )

// Parse CLI script code
let parseCliScript
  (exeState : RT.ExecutionState)
  (branchID : Option<System.Guid>)
  (pm : Dval)
  (owner : string)
  (scriptName : string)
  (code : string)
  : Ply<Result<Utils.CliScript.PTCliScriptModule, RuntimeError.Error>> =
  uply {
    let onMissingAllow = createOnMissingAllow ()

    let args =
      NEList.ofList
        (BranchID.toDT branchID)
        [ DString owner
          DString scriptName
          onMissingAllow
          pm
          DString scriptName
          DString code ]

    let parseCliScriptFnName =
      FQFnName.Package PackageIDs.Fn.LanguageTools.Parser.CliScript.parseCliScript

    let! execResult = Exe.executeFunction exeState parseCliScriptFnName [] args

    match execResult with
    | Ok dval ->
      match C2DT.Result.fromDT identity dval identity with
      | Ok parsedModuleAndUnresolvedNames ->
        return (Utils.CliScript.fromDT parsedModuleAndUnresolvedNames) |> Ok
      | Error(DString errMsg) ->
        return Error(RuntimeError.UncaughtException(errMsg, []))
      | Error _ ->
        return
          Exception.raiseInternal
            "Invalid error format from parseCliScript"
            [ "dval", dval ]
    | Error(rte, _cs) ->
      let! rteString = Exe.runtimeErrorToString branchID exeState rte
      match rteString with
      | Ok errorDval ->
        return
          Exception.raiseInternal
            "Error executing parseCliScript function"
            [ "rte", errorDval ]
      | Error(nestedRte, _cs) ->
        return
          Exception.raiseInternal
            "Error running runtimeErrorToString"
            [ "original rte", rte; "nested rte", nestedRte ]
  }


module ExecutionError =
  let fqTypeName = FQTypeName.fqPackage PackageIDs.Type.Cli.executionError
  let typeRef = TCustomType(Ok fqTypeName, [])


let pmRT = LibPackageManager.PackageManager.rt
let ptPM = LibPackageManager.PackageManager.pt

let builtinsToUse : RT.Builtins =
  LibExecution.Builtin.combine
    [ BuiltinExecution.Builtin.builtins
        BuiltinExecution.Libs.HttpClient.defaultConfig
      BuiltinCli.Builtin.builtins
      BuiltinPM.Builtin.builtins ptPM ]
    []


let execute
  (parentState : RT.ExecutionState)
  (mod' : Utils.CliScript.PTCliScriptModule)
  (_args : List<Dval>) // CLEANUP update to List<String>, and extract in builtin
  : Ply<RT.ExecutionResult> =
  uply {
    let (program : Program) =
      { canvasID = System.Guid.NewGuid()
        internalFnsAllowed = false
        secrets = []
        dbs = Map.empty }

    let types =
      List.concat
        [ mod'.types |> List.map PT2RT.PackageType.toRT
          mod'.submodules.types |> List.map PT2RT.PackageType.toRT ]

    let values =
      List.concat
        [ mod'.values |> List.map PT2RT.PackageValue.toRT
          mod'.submodules.values |> List.map PT2RT.PackageValue.toRT ]

    let fns =
      List.concat
        [ mod'.fns |> List.map PT2RT.PackageFn.toRT
          mod'.submodules.fns |> List.map PT2RT.PackageFn.toRT ]

    // TODO we should probably use LibPM's in-memory grafting thing instead of this
    // (no need for RT.PM.withExtras to exist, I think)
    let pm = pmRT |> PackageManager.withExtras types values fns

    let tracing = Exe.noTracing

    let state =
      Exe.createState
        builtinsToUse
        pm
        tracing
        parentState.reportException
        parentState.notify
        program

    match mod'.exprs with
    | [] ->
      return
        RuntimeError.CLIs.NoExpressionsToExecute
        |> RuntimeError.CLI
        |> raiseUntargetedRTE
    | exprs ->
      let exprInsrts = exprs |> List.map (PT2RT.Expr.toRT Map.empty 0 None)
      let results = exprInsrts |> List.map (Exe.executeExpr state)
      match List.tryLast results with
      | Some lastResult -> return! lastResult
      | None ->
        return
          Exception.raiseInternal
            "No results from executing expressions (which should be impossible..)"
            []
  }


let fns : List<BuiltInFn> =
  [ { name = fn "cliParseAndExecuteScript" 0
      typeParams = []
      parameters =
        [ Param.make "branchID" (TypeReference.option TUuid) ""
          Param.make "filename" TString ""
          Param.make "code" TString ""
          Param.make "args" (TList TString) "" ]
      returnType = TypeReference.result TInt64 ExecutionError.typeRef
      description =
        "Parses Dark code as a script, and and executes it, returning an exit code"
      fn =
        let errType = KTCustomType(ExecutionError.fqTypeName, [])
        let resultOk = Dval.resultOk KTInt64 errType
        let resultError = Dval.resultError KTInt64 errType
        (function
        | exeState,
          _,
          [],
          [ branchID; DString filename; DString code; DList(_vtTODO, scriptArgs) ] ->
          uply {
            let branchID = BranchID.fromDT branchID
            let! pm = executePM exeState branchID
            let! parsedScript =
              parseCliScript exeState branchID pm "CliScript" filename code

            try
              match parsedScript with
              | Ok mod' ->
                match! execute exeState mod' scriptArgs with
                | Ok(DInt64 i) -> return resultOk (DInt64 i)
                | Ok result ->
                  return
                    RuntimeError.CLIs.NonIntReturned result
                    |> RuntimeError.CLI
                    |> RT2DT.RuntimeError.toDT
                    |> resultError
                | Error(e, callStack) ->
                  let! csString = Exe.callStackString exeState callStack
                  print $"Error when executing Script. Call-stack:\n{csString}\n"
                  return e |> RT2DT.RuntimeError.toDT |> resultError
              | Error e -> return e |> RT2DT.RuntimeError.toDT |> resultError
            with e ->
              return createExceptionError e |> RT2DT.RuntimeError.toDT |> resultError
          }
        | _ -> incorrectArgs ())
      sqlSpec = NotQueryable
      previewable = Impure
      deprecated = NotDeprecated }


    // TODO: better handling for functions that takes string args
    { name = fn "cliExecuteFunction" 0
      typeParams = []
      parameters =
        [ Param.make "branchID" (TypeReference.option TUuid) ""
          Param.make "functionName" TString ""
          Param.make "args" (TList(TCustomType(Ok PT2DT.Expr.typeName, []))) "" ]
      returnType = TypeReference.result TString ExecutionError.typeRef
      description =
        "Executes an arbitrary Dark package function using the new darklang parser"
      fn =
        let errType = KTCustomType(ExecutionError.fqTypeName, [])
        let resultOk = Dval.resultOk KTString errType
        let resultError = Dval.resultError KTString errType

        function
        | exeState, _, [], [ branchID; DString functionName; DList(_vtTODO, args) ] ->
          uply {
            let branchID = BranchID.fromDT branchID

            let err (msg : string) (metadata : List<string * string>) : Dval =
              let fields =
                [ ("msg", DString msg)
                  ("metadata",
                   DDict(
                     VT.string,
                     metadata |> List.map (Tuple2.mapSecond DString) |> Map
                   )) ]

              DRecord(
                ExecutionError.fqTypeName,
                ExecutionError.fqTypeName,
                [],
                Map fields
              )
              |> resultError

            let exnError (e : exn) : Dval =
              let msg = Exception.getMessages e |> String.concat "\n"
              let metadata =
                Exception.toMetadata e |> List.map (fun (k, v) -> k, string v)
              err msg metadata

            try
              let resolveFn =
                FQFnName.Package
                  PackageIDs.Fn.LanguageTools.NameResolver.FnName.resolve

              let onMissingAllow = createOnMissingAllow ()

              let parserRangeType =
                FQTypeName.Package PackageIDs.Type.LanguageTools.Parser.range
              let pointType =
                FQTypeName.Package PackageIDs.Type.LanguageTools.Parser.point
              let pointFields = [ ("row", DInt64 0); ("column", DInt64 0) ]
              let fields =
                [ ("start", DRecord(pointType, pointType, [], Map pointFields))
                  ("end_", DRecord(pointType, pointType, [], Map pointFields)) ]

              let rangeParser =
                DRecord(parserRangeType, parserRangeType, [], Map fields)
              let writtenTypesNameType =
                FQTypeName.Package PackageIDs.Type.LanguageTools.WrittenTypes.name

              let parts = functionName.Split('.') |> List.ofArray
              let currentModule = DList(VT.string, [])
              let nameArg =
                DEnum(
                  writtenTypesNameType,
                  writtenTypesNameType,
                  [],
                  "Unresolved",
                  [ rangeParser; DList(VT.string, parts |> List.map DString) ]
                )

              let! pm = executePM exeState branchID

              let resolveFnArgs =
                NEList.ofList
                  (BranchID.toDT branchID)
                  [ onMissingAllow; pm; RT.DString "Cli"; currentModule; nameArg ]

              let! execResult =
                Exe.executeFunction exeState resolveFn [] resolveFnArgs

              let! fnNameResult =
                uply {
                  match execResult with
                  | Ok dval ->
                    let nre =
                      C2DT.Result.fromDT
                        PT2DT.FQFnName.fromDT
                        dval
                        PT2DT.NameResolutionError.fromDT

                    match nre with
                    | Ok fnName -> return Ok fnName
                    | Error nameErr ->
                      match nameErr with
                      | PT.NameResolutionError.NotFound names ->
                        let nameStr = names |> String.concat "."
                        return Error $"Function not found: {nameStr}"
                      | PT.NameResolutionError.InvalidName names ->
                        let nameStr = names |> String.concat "."
                        return Error $"Invalid function name: {nameStr}"
                  | Error rte ->
                    return
                      Exception.raiseInternal
                        "Error executing resolve function"
                        [ "rte", rte ]
                }

              match fnNameResult with
              | Ok fnName ->
                let! fn =
                  match PT2RT.FQFnName.toRT fnName with
                  | FQFnName.Package pkg -> exeState.fns.package pkg
                  | _ ->
                    Exception.raiseInternal
                      "Error constructing package function name"
                      [ "fn", fn ]

                match fn with
                | None -> return err "Function not found" [ "fn", fnName.ToString() ]
                | Some f ->
                  let newArgs =
                    args
                    |> List.collect (fun dval ->
                      match dval with
                      | DEnum(_, _, _, _, fields) -> fields |> List.tail
                      | e -> Exception.raiseInternal "Invalid Expr" [ "e", e ])

                  let newArgs = if newArgs = [] then [ RT.DUnit ] else newArgs

                  let! result =
                    Exe.executeFunction
                      exeState
                      (FQFnName.Package f.id)
                      []
                      (NEList.ofList newArgs.Head newArgs.Tail)

                  match result with
                  | Error(rte, _cs) ->
                    match! Exe.runtimeErrorToString branchID exeState rte with
                    | Ok(DString s) -> return err s []
                    | _ ->
                      let rte =
                        rte |> RT2DT.RuntimeError.toDT |> DvalReprDeveloper.toRepr
                      return
                        err
                          $"An error occured trying to print a runtime error:\n\noriginal error:\n{rte}"
                          []

                  | Ok value ->
                    match value with
                    | DString s -> return resultOk (DString s)
                    | _ ->
                      let asString = DvalReprDeveloper.toRepr value
                      return resultOk (DString asString)
              | Error errMsg -> return err errMsg []
            with e ->
              return exnError e
          }
        | _ -> incorrectArgs ()
      sqlSpec = NotQueryable
      previewable = Impure
      deprecated = NotDeprecated }


    { name = fn "cliEvaluateExpression" 0
      typeParams = []
      parameters =
        [ Param.make "branchID" (TypeReference.option TUuid) ""
          Param.make "expression" TString "" ]
      returnType = TypeReference.result TString ExecutionError.typeRef
      description = "Evaluates a Dark expression and returns the result as a Strin"
      fn =
        let errType = KTCustomType(ExecutionError.fqTypeName, [])
        let resultOk = Dval.resultOk KTString errType
        let resultError = Dval.resultError KTString errType
        (function
        | exeState, _, [], [ branchID; DString expression ] ->
          uply {
            let branchID = BranchID.fromDT branchID
            let! pm = executePM exeState branchID
            let! parsedScript =
              parseCliScript
                exeState
                branchID
                pm
                "CliScript"
                "exprWrapper"
                expression

            try
              match parsedScript with
              | Ok mod' ->
                match! execute exeState mod' [] with
                | Ok result ->
                  match result with
                  | DString s -> return resultOk (DString s)
                  | _ ->
                    let asString = DvalReprDeveloper.toRepr result
                    return resultOk (DString asString)
                | Error(e, callStack) ->
                  let! csString = Exe.callStackString exeState callStack
                  print $"Error when executing expression. Call-stack:\n{csString}\n"
                  return e |> RT2DT.RuntimeError.toDT |> resultError
              | Error e -> return e |> RT2DT.RuntimeError.toDT |> resultError
            with e ->
              return createExceptionError e |> RT2DT.RuntimeError.toDT |> resultError
          }
        | _ -> incorrectArgs ())
      sqlSpec = NotQueryable
      previewable = Impure
      deprecated = NotDeprecated } ]

let builtins = LibExecution.Builtin.make [] fns
